home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / VIS082S.ARJ / CHATSTUF.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-18  |  57KB  |  2,094 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
  2.  
  3. unit chatstuf;        (* Chat Mode and F2 Keys *)
  4.  
  5. interface
  6.  
  7. uses crt,dos,
  8.      gentypes,gensubs,subs1,userret,flags,mainr1,modem,windows,statret,
  9.      configrt,ExecSwap,FastTTT5,WinTTT5,MenuTTT5,PullTTT5;
  10.  
  11. function specialcommand:boolean;
  12. procedure specialseries;
  13. procedure chat (gotospecial,color:boolean);
  14. Procedure BustChat;
  15.  
  16. implementation
  17.  
  18.  
  19.   procedure write1 (l:lstr);
  20.   begin
  21.    gotoxy (25,5);
  22.    textcolor (12);
  23.    textbackground (0);
  24.    write (usr,l);
  25.   end;
  26.  
  27.   function getstring (t:anystr):anystr;
  28.   var mm,lz:anystr;
  29.   begin
  30.     textbackground (0);
  31.     textcolor (12);
  32.     write (usr,t);
  33.     readline (mm);
  34.     getstring:=mm;
  35.   end;
  36.  
  37. function specialcommand:boolean;
  38.  
  39.  
  40. Const Right=#205;       (* Constants used to define the arrow keys *)
  41.       Left=#203;
  42.       Up=#200;
  43.       Down=#208;
  44.       NormFore=15;      (* Color Constants *)
  45.       NormBack=1;
  46.       HighFore=1;
  47.       HighBack=7;
  48.       SwapLoc:Array[Boolean] of String[7]=('on disk','in EMS');  (* Full Mem
  49.                                                                      Swaps *)
  50.  
  51. Var C:Char;
  52.     Quit:Boolean;
  53.     Major,Minor,Mainx,Mainy:Integer;
  54.     Main_Choice,Choice,Error:integer;
  55.     ScanTop, ScanBot:byte;
  56.     M1,MM:Menu_record;
  57.     Ch:char;
  58.     X,Y:Byte;
  59.     Done:Boolean;
  60.  
  61.     Function ReadStri:Mstr;
  62.     Var MM:Mstr;
  63.     Begin
  64.       ReadLine(MM);
  65.       ReadStri:=MM;
  66.     End;
  67.  
  68.     Procedure SendMsg(M:Lstr);
  69.     Begin
  70. (*      ClearBreak;
  71.       GotoXy(MainX,MainY);
  72.       ClrEol;
  73.       WriteLn(M); *)
  74.     End;
  75.  
  76.     Procedure SplitEm;
  77.     Var Cnt:Integer;
  78.     Begin
  79.       If SplitMode then Unsplit;
  80.       GotoXy(1,15);
  81.       TextColor(9);
  82.       For Cnt:=1 to 80 Do Write(Usr,'─');
  83.     End;
  84.  
  85.     Procedure ClearTop(Where:Byte);
  86.     Var Cnt:Integer;
  87.     Begin
  88.       FillScreen(1,1,80,Where,blue,blue,chr(176)); Main_Choice:=1;
  89.       TextColor(8);
  90.       Textbackground(1);
  91.       For CNT:=1 to 80 Do Begin
  92.         Gotoxy(cnt,Where+1);
  93.         Write(usr,'▄');
  94.       End;
  95.       TextColor(15);
  96.     End;
  97.  
  98.     Procedure DrawABox(Count:Integer; Msg:Lstr);
  99.     Var Cnt:Integer;
  100.     Begin
  101.     TextColor(9);
  102.     TextBackground(NormBack);
  103.     GotoXy(1,1);
  104.     Write(Usr,'╒');
  105.     For Cnt:=1 to 78 Do Write(Usr,'═');
  106.     Write(Usr,'╕');
  107.     For Cnt:=1 to Count Do
  108.       Begin
  109.       GotoXy(1,1+Cnt);
  110.       Write(Usr,'│');
  111.       GotoXy(80,1+Cnt);
  112.       Write(Usr,'│');
  113.       End;
  114.     GotoXy(1,Count+2);
  115.     Write(Usr,'╘');
  116.     For Cnt:=1 to (38-(Length(Msg) div 2)) Do
  117.      Write(Usr,'═');
  118.      Textcolor(12);
  119.      Write(Usr,'[ '+Msg+' ]');
  120.      TextColor(9);
  121.      While WhereX<80 Do Write(Usr,'═');
  122.      Write(Usr,'╛');
  123.      TextBackground(0);
  124.     End;
  125.  
  126.     Procedure WriteXy(A,B:Integer; M:String);
  127.     Begin
  128.       GotoXy(A,B);
  129.       Write(Usr,M);
  130.     End;
  131.  
  132.     Procedure DoUserEditing;
  133.     Var T:Mstr;
  134.         Tx:Integer;
  135.         LastMinor,Cnet:Integer;
  136.  
  137.      Procedure DoTop;
  138.      Var Cnt:Integer;
  139.      Begin
  140.      ClearTop(20);
  141.      DrawABox(17,'ViSiON v0.82 Online User Editing');
  142.      Minor:=1;
  143.     End;
  144.  
  145.     Procedure ClearBytes(Byt:Integer);
  146.     Var X,Y,Cnt:Integer;
  147.     Begin
  148.       X:=WhereX;
  149.       Y:=WhereY;
  150.       For Cnt:=1 to Byt Do Write(Usr,' ');
  151.       GotoXy(X,Y);
  152.     End;
  153.  
  154.     Procedure DrawThem;
  155.      Procedure yel;
  156.      Begin
  157.      Textcolor(14);
  158.      End;
  159.     Begin
  160.       TextBackGround(NormBack);
  161.       TextColor(NormFore);
  162.       WriteXy(33,2,'Editing User #'+Strr(Unum)+'   ');
  163.       Case LastMinor of
  164.            1:Begin
  165.               WriteXy(3,3,' Handle ');yel;
  166.               WriteXy(16,3,urec.handle+'         ');
  167.              End;
  168.            2:Begin
  169.               WriteXy(3,4,' Name ');yel;
  170.               WriteXy(16,4,Urec.RealName+'           ');
  171.              End;
  172.            3:Begin
  173.               WriteXy(3,5,' Level ');yel;
  174.               WriteXy(16,5,Strr(Urec.Level)+'    ');
  175.              End;
  176.            4:Begin
  177.               WriteXy(3,6,' G-F Lvl ');yel;
  178.               WriteXy(16,6,Strr(Urec.Glevel)+'    ');
  179.              End;
  180.            5:Begin
  181.               WriteXy(3,7,' G-F Pts ');yel;
  182.               WriteXy(16,7,strr(Urec.Gpoints)+'    ');
  183.              End;
  184.             6:Begin
  185.                WriteXy(3,8,' File Lvl ');yel;
  186.                WriteXy(16,8,Strr(Urec.UDLevel)+'    ');
  187.               End;
  188.             7:Begin
  189.                WriteXy(3,9,' File Pts ');yel;
  190.                WriteXy(16,9,strr(Urec.UDPoints)+'    ');
  191.               End;
  192.             8:Begin
  193.                WriteXy(3,10,' Password ');yel;
  194.                WriteXy(16,10,Urec.PassWord+'    ');
  195.               End;
  196.             9:Begin
  197.                WriteXy(3,11,' Phone Num ');yel;
  198.                WriteXy(16,11,Urec.PhoneNum+'    ');
  199.               End;
  200.             10:Begin
  201.                 WriteXy(3,12,' Daily Time ');yel;
  202.                 WriteXy(16,12,strr(Urec.TimeLimits)+'    ');
  203.                End;
  204.             11:Begin
  205.                 WriteXy(3,13,' User Note ');yel;
  206.                 WriteXy(16,13,Urec.UserNote+'     ');
  207.                End;
  208.             12:Begin
  209.                 WriteXy(3,14,' Macro 1 ');yel;
  210.                 WriteXy(16,14,Urec.Macro1+'     ');
  211.                End;
  212.             13:Begin
  213.                 WriteXy(3,15,' Macro 2 ');yel;
  214.                 WriteXy(16,15,Urec.Macro2+'      ');
  215.                End;
  216.             14:Begin
  217.                 WriteXy(3,16,' Macro 3 ');yel;
  218.                 WriteXy(16,16,urec.macro3+'       ');
  219.                End;
  220.             15:Begin
  221.                 WriteXy(3,17,' Sysop Note ');yel;
  222.                 WriteXy(16,17,Urec.SpecialSysopNote+'    ');
  223.                End;
  224.             16:Begin
  225.                 WriteXy(57,3,' UD K Ratio ');yel;
  226.                 WriteXy(70,3,strr(Urec.UDKRatio)+'    ');
  227.                End;
  228.             17:Begin
  229.                 WriteXy(57,4,' PCR ');yel;
  230.                 WriteXy(70,4,strr(Urec.PCRatio)+'    ');
  231.                End;
  232.             18:WriteXy(57,5,' Time Left ');
  233.             19:Begin
  234.                 WriteXy(57,6,' U/D Ratio ');yel;
  235.                 WriteXy(70,6,Strr(Urec.UDRatio)+'    ');
  236.                End;
  237.             20:Begin
  238.                 WriteXy(57,7,' Posts ');yel;
  239.                 WriteXy(70,7,Strr(Urec.Nbu)+'    ');
  240.                End;
  241.             21:Begin
  242.                 WriteXy(57,8,' Uploads ');yel;
  243.                 WriteXy(70,8,Strr(Urec.Uploads)+'  ');
  244.                End;
  245.             22:Begin
  246.                 WriteXy(57,9,' Downloads ');yel;
  247.                 WriteXy(70,9,Strr(Urec.Downloads)+'  ');
  248.                End;
  249.             23:Begin
  250.                 WriteXy(57,10,' U/L KB ');yel;
  251.                 WriteXy(70,10,Strr(Urec.UpKay)+'k');
  252.                End;
  253.             24:Begin
  254.                 WriteXy(57,11,' D/L KB ');yel;
  255.                 WriteXy(70,11,Strr(Urec.Dnkay)+'k');
  256.                End;
  257.             25:Begin
  258.                 WriteXy(57,12,' Calls ');yel;
  259.                 WriteXy(70,12,Strr(Urec.NumOn));
  260.                End;
  261.             26:Begin
  262.                 WriteXy(57,13,' Exp Date ');yel;
  263.                 If DateStr(Urec.ExpDate)='0/0/80' then WriteXy(70,13,'N/A      ')
  264.                   Else
  265.                 WriteXy(70,13,DateStr(Urec.ExpDate));
  266.                End;
  267.             27:Begin
  268.                 WriteXy(57,14,' Wanted Flag ');yel;
  269.                 WriteXy(70,14,YesNo(Wanted in Urec.Config)+' ');
  270.                 End;
  271.             28:Begin
  272.                 WriteXy(57,15,' Time bank ');yel;
  273.                 WriteXy(70,15,Strr(Urec.TimeBank)+'    ');
  274.                End;
  275.             29:Begin
  276.                 WriteXy(57,16,' GFile Uls ');yel;
  277.                 WriteXy(70,16,Strr(Urec.Nup)+'    ');
  278.                End;
  279.             30:Begin
  280.                 WriteXy(57,17,' GFile Dls ');yel;
  281.                 WriteXy(70,17,Strr(Urec.Ndn)+'  ');
  282.                End;
  283.             End; (* End Case *)
  284.       TextBackGround(HighBack);
  285.       TextColor(HighFore);
  286.       Case Minor of
  287.           1:WriteXy(3,3,' Handle ');
  288.           2:WriteXy(3,4,' Name ');
  289.           3:WriteXy(3,5,' Level ');
  290.           4:WriteXy(3,6,' G-F Lvl ');
  291.           5:WriteXy(3,7,' G-F Pts ');
  292.           6:WriteXy(3,8,' File Lvl ');
  293.           7:WriteXy(3,9,' File Pts ');
  294.           8:WriteXy(3,10,' Password ');
  295.           9:WriteXy(3,11,' Phone Num ');
  296.           10:WriteXy(3,12,' Daily Time ');
  297.           11:WriteXy(3,13,' User Note ');
  298.           12:Writexy(3,14,' Macro 1 ');
  299.           13:writexy(3,15,' Macro 2 ');
  300.           14:writexy(3,16,' Macro 3 ');        
  301.           15:writexy(3,17,' SysOp Note ');
  302.           16:WriteXy(57,3,' UD K Ratio ');
  303.           17:WriteXy(57,4,' PCR ');
  304.           18:WriteXy(57,5,' Time Left ');
  305.           19:WriteXy(57,6,' U/D Ratio ');
  306.           20:WriteXy(57,7,' Posts ');
  307.           21:WriteXy(57,8,' Uploads ');
  308.           22:WriteXy(57,9,' Downloads ');
  309.           23:WriteXy(57,10,' U/L KB ');
  310.           24:WriteXy(57,11,' D/L KB ');
  311.           25:WriteXy(57,12,' Calls ');
  312.           26:WriteXy(57,13,' Exp Date ');
  313.           27:WriteXy(57,14,' Wanted Flag ');
  314.           28:Writexy(57,15,' Time Bank');
  315.           29:Writexy(57,16,' GFile ULs');
  316.           30:writexy(57,17,' GFile DLs');
  317.       End;
  318.       LastMinor:=Minor;
  319.       TextBackground(NormBack);
  320.       TextColor(NormFore);
  321.     End;
  322.  
  323.     Procedure Goty(X,Y,B:Integer);
  324.     Begin
  325.     GotoXy(X,Y);
  326.     ClearBytes(b);
  327.     End;
  328.  
  329.     Begin
  330.       DoTop;
  331.       LastMinor :=1;
  332.       For Cnet:=1 to 30 Do
  333.       Begin
  334.         Minor:=Cnet;
  335.         Drawthem;
  336.         End;
  337.       Minor:=1;
  338.       DrawThem;
  339.       Repeat
  340.         C:=BiosKey;
  341.          Case C Of
  342.            Up:Dec(Minor);
  343.            Down:Inc(Minor);
  344.            Right,Left:If Minor<16 then Minor:=Minor+15 Else Minor:=Minor-15;
  345.            #13:Begin
  346.                If Minor<16 Then Goty(16,Minor+2,35)
  347.                  Else
  348.                  Goty(70,Minor+2-15,5);
  349.                OnCursor;
  350.                Case Minor Of
  351.                 1:Begin
  352.                    T:=ReadStri;
  353.                    If T<>'' then Urec.Handle:=T;
  354.                    SendMsg('Your Handle has been changed to '+Urec.Handle);
  355.                   End;
  356.                 2:Begin
  357.                    T:=ReadStri;
  358.                    If T<>'' then Urec.RealName:=T;
  359.                    SendMsg('Your Real Name has been Changed to '+Urec.RealName);
  360.                   End;
  361.                 3:Begin
  362.                    T:=ReadStri;
  363.                    Tx:=Valu(T);
  364.                    Urec.Level:=Tx;
  365.                    Ulvl:=Tx;
  366.                    SendMsg('You have been granted '+Strr(Urec.Level)+' Access.');
  367.                   End;
  368.                 4:Begin
  369.                    T:=ReadStri;
  370.                    Tx:=Valu(T);
  371.                    Urec.Glevel:=Tx;
  372.                    SendMsg('Your G-File Level has been changed to '+Strr(Urec.Glevel));
  373.                   End;
  374.                 5:Begin
  375.                    T:=ReadStri;
  376.                    Tx:=Valu(T);
  377.                    Urec.Gpoints:=Tx;
  378.                    SendMsg('You have been given '+Strr(Urec.Gpoints)+' G-File Points');
  379.                   End;
  380.                 6:Begin
  381.                    T:=ReadStri;
  382.                    Tx:=Valu(T);
  383.                    Urec.Udlevel:=Tx;
  384.                    SendMsg('Your Upload/Download Level has been set to '+Strr(Urec.UdLevel));
  385.                   End;
  386.                 7:Begin
  387.                    T:=ReadStri;
  388.                    Tx:=Valu(T);
  389.                    Urec.UdPoints:=Tx;
  390.                    SendMsg('You now have '+strr(Urec.UdPoints)+' file points.');
  391.                   End;
  392.                 8:Begin
  393.                    T:=ReadStri;
  394.                    If T<>'' then Urec.Password:=T;
  395.                    SendMsg('Your password has been changed to '+Urec.Password);
  396.                   End;
  397.                 9:Begin
  398.                    T:=ReadStri;
  399.                    If T<>'' then Urec.PhoneNum:=T;
  400.                    SendMsg('Your Phone Number has been changed to '+Urec.PhoneNum);
  401.                   End;
  402.                 10:Begin
  403.                     T:=ReadStri;
  404.                     Tx:=Valu(T);
  405.                     Urec.TimeLimits:=Tx;
  406.                     SendMsg('Your daily time limit has been set to '+Strr(Urec.TimeLimits));
  407.                    End;
  408.                 11:Begin
  409.                     T:=ReadStri;
  410.                     If T<>'' then
  411.                       Urec.UserNote:=T;
  412.                     SendMsg('Your Account Note has been Changed to '+Urec.UserNote);
  413.                    End;
  414.                 12:Begin
  415.                     T:=ReadStri;
  416.                     If T<>'' then Urec.Macro1:=T;
  417.                     SendMsg('Your macro #1 has been changed to '+T);
  418.                    End;
  419.                  13:Begin
  420.                     t:=readstri;
  421.                     if t<>'' then Urec.Macro2:=T;
  422.                     SendMsg('Your Macro #2 has been changed to '+T);
  423.                    End;
  424.                  14:Begin
  425.                     t:=ReadStri;
  426.                     If T<>'' then Urec.Macro2:=T;
  427.                     SendMsg('Your Macro #3 has been changed to '+T);
  428.                    End; 
  429.                 15:Begin
  430.                     T:=ReadStri;
  431.                     If T<>'' then Urec.SpecialSysopNote:=T;
  432.                    End;
  433.                 19:Begin
  434.                     T:=ReadStri;
  435.                     Tx:=Valu(T);
  436.                     Urec.UDRatio:=Tx;
  437.                     SendMsg('Your minimum Upload/Download ratio has been set to '+Strr(Urec.UdRatio));
  438.                    End;
  439.                 16:Begin
  440.                     T:=ReadStri;
  441.                     Tx:=Valu(T);
  442.                     Urec.UDKRatio:=Tx;
  443.                     SendMsg('Your minimum Upload/Download K Ratio has been set to '+Strr(urec.Udkratio));
  444.                    End;
  445.                 17:Begin
  446.                     T:=ReadStri;
  447.                     Tx:=Valu(T);
  448.                     Urec.PCRatio:=Tx;
  449.                     SendMsg('Your minimum Post/Call Ratio has been set to '+Strr(Urec.PCRatio));
  450.                    End;
  451.                 18:Begin
  452.                     T:=ReadStri;
  453.                     GotY(70,5,5);
  454.                     SetTimeLeft(Valu(T));
  455.                     bottomline;
  456.                     SendMsg('You have been given '+Strr(Valu(T))+' Minutes for today.');
  457.                    End;
  458.                 20:Begin
  459.                     T:=ReadStri;
  460.                     Tx:=Valu(T);
  461.                     Urec.Nbu:=Tx;
  462.                     SendMsg('Your POSTS have been set to '+Strr(Urec.Nbu));
  463.                    End;
  464.                 21:Begin
  465.                     T:=ReadStri;
  466.                     Tx:=Valu(T);
  467.                     Urec.Uploads:=Tx;
  468.                     SendMsg('Your Uploads have been set to '+Strr(Urec.Uploads));
  469.                    End;
  470.                 22:Begin
  471.                    T:=ReadStri;
  472.                    Tx:=Valu(T);
  473.                    Urec.Downloads:=Tx;
  474.                    SendMsg('Your Downloads have been set to '+Strr(Urec.Downloads));
  475.                   End;
  476.                 23:Begin
  477.                     T:=ReadStri;
  478.                     Tx:=Valu(T);
  479.                     Urec.UpKay:=Tx;
  480.                     SendMsg('Your Upload K-Bytes have been set to '+Strr(Tx)+'k');
  481.                    End;
  482.                 24:Begin
  483.                     T:=ReadStri;
  484.                     Tx:=Valu(T);
  485.                     Urec.DnKay:=Tx;
  486.                     SendMsg('Your Download K-Bytes have been set to '+Strr(Tx)+'k');
  487.                    End;
  488.                 25:Begin
  489.                     T:=ReadStri;
  490.                     Tx:=Valu(T);
  491.                     Urec.NumOn:=Tx;
  492.                     SendMsg('Your total calls have been set to '+Strr(Tx));
  493.                    End;
  494.                 26:Begin
  495.                     T:=ReadStri;
  496.                     If T<>'' then Begin
  497.                       Urec.ExpDate:=DateVal(T);
  498.                       SendMsg('Your Expiration Date has been set to '+DateStr(Urec.ExpDate));
  499.                    End;
  500.                 End;
  501.                 27:If Wanted in Urec.Config then Urec.Config:=Urec.Config-[Wanted] Else
  502.                     Urec.Config:=Urec.Config+[Wanted];
  503.                 28:Begin
  504.                     T:=ReadStri;
  505.                     Tx:=Valu(T);
  506.                     Urec.TimeBank:=Tx;
  507.                     SendMsg('Your time in your time bank has been set to '+Strr(Tx));
  508.                    End;
  509.                  29:Begin
  510.                     T:=ReadStri;
  511.                     Tx:=Valu(T);
  512.                     Urec.Nup:=Tx;
  513.                     SendMsg('Your G-File Uploads have been set to '+Strr(Tx));
  514.                    End;
  515.                  30:Begin
  516.                     T:=ReadStri;
  517.                     Tx:=Valu(T);
  518.                     Urec.Ndn:=Tx;
  519.                     SendMsg('Your G-File Downloads have been set to '+Strr(Tx));
  520.                    End;
  521.                End;
  522.               OffCursor;
  523.            End;
  524.            End;
  525.          If Minor=31 then Minor:=1;
  526.          If Minor=0 then Minor:=30;
  527.         DrawThem;
  528.       Until C=#27;
  529.       TextBackGround(0);
  530.       FillScreen(1,1,80,24,white,blue,chr(176));
  531.       Main_Choice:=1;
  532.     End;
  533.  
  534. Procedure DoAccessFlags;
  535. Var Quit:Boolean;
  536.   Procedure DrawTop;
  537.   Var Cnt:Integer;
  538.   Begin
  539.    DrawABox(4,'Access Flag Editing Commands');
  540.    Minor:=1;
  541.   End;
  542.  
  543.   Procedure GetMainConferences;
  544.  
  545.      Procedure DrawT;
  546.      Var Cnt:Integer;
  547.      Begin
  548.        DrawABox(5,'Access to Main Conferences');
  549.        Minor:=1;
  550.      End;
  551.  
  552.    Procedure Choices;
  553.    Var CountMe:Integer;
  554.    Begin
  555.     TextBackground(NormBack);
  556.     TextColor(NormFore);
  557.     for countme:=1 to 5 do
  558.     Begin
  559.       GotoXy(31,1+CountMe);
  560.       Write(Usr,' Conference ',countme,' - ');
  561.       if Urec.Conf[CountMe] then Write(Usr,'Yes ') else
  562.        Write(Usr,'No  ');
  563.     End;
  564.     GotoXy(31,1+Minor);
  565.     TextColor(HighFore);
  566.     TextBackground(HighBack);
  567.     Write(Usr,' Conference ',Minor,' - ');
  568.     If Urec.Conf[Minor] then Write(Usr,'Yes ') else Write(Usr,'No  ');
  569.     TextColor(NormFore);
  570.     TextBackground(NormBack);
  571.     End;
  572.  
  573.  
  574.    Begin
  575.      ClearTop(7);
  576.      DrawT;
  577.      Repeat
  578.       Choices;
  579.       C:=BiosKey;
  580.       Case C Of
  581.         Left,Up:Dec(Minor);
  582.         Down,Right:Inc(Minor);
  583.         #13:Begin
  584.             Urec.Conf[Minor]:=Not Urec.Conf[Minor];
  585.             If Urec.Conf[Minor] then SendMsg('You have been granted access to main conference #'+Strr(Minor))
  586.             Else SendMsg('You have been denied access to Main Conference #'+Strr(Minor));
  587.           End;
  588.        End;
  589.        If Minor>5 then Minor:=1;
  590.        If Minor<1 then Minor:=5;
  591.       Until C=#27;
  592.       FillScreen(1,1,80,24,white,blue,chr(176));
  593.       Main_Choice:=1;
  594.    End;
  595.  
  596.   Procedure GetSubConferences;
  597.   Var T:Mstr;
  598.       Tx:Integer;
  599.  
  600.   Procedure ShowSubs;
  601.    Var Cnt:Integer;
  602.    Begin
  603.      ClearTop(7);
  604.      GotoXy(1,1);
  605.      WriteLn(Usr,'                       Sub Conference Access Flags');
  606.      Write(Usr,^M^J);
  607.      Write(Usr,'         ');
  608.      For Cnt:=1 to 18 do
  609.       If Urec.Confset[Cnt]>0 then Write(Usr,Cnt,',') Else
  610.       Write(Usr,'0,');
  611.      Write(Usr,^M^J);
  612.      Write(Usr,'         ');
  613.      For Cnt:=19 to 31 Do
  614.        If Urec.Confset[Cnt]>0 then Write(Usr,Cnt,',') Else
  615.        Write(Usr,'0,');
  616.      If Urec.ConfSet[32]>0 then WriteLn(Usr,'32') else writeLn(Usr,'0');
  617.    End;
  618.  
  619.    Begin
  620.      Repeat
  621.        ShowSubs;
  622.        Write(Usr,^M^J);
  623.        Write(Usr,'Enter conference to change, or [Return] to exit:');
  624.        T:=ReadStri;
  625.        If T<>'' then Begin
  626.          Tx:=Valu(T);
  627.          If (Tx>0) and (TX<33) then
  628.            If Urec.ConfSet[Tx]=0 then Urec.Confset[Tx]:=1 Else
  629.            Urec.Confset[Tx]:=0;
  630.          End;
  631.        Until T='';
  632.        FillScreen(1,1,80,24,white,blue,chr(176));
  633.        Main_Choice:=1;
  634.      End;
  635.  
  636.   procedure getnewaccess;
  637.   var q,bname:sstr;
  638.       bn:integer;
  639.       ac:accesstype;
  640.       wasopen:boolean;
  641.       k:char;
  642.  
  643.     function inputaccess (q:sstr):accesstype;
  644.     begin
  645.       inputaccess:=invalid;
  646.       if length(q)=0 then exit;
  647.       case upcase(q[1]) of
  648.         'L':inputaccess:=letin;
  649.         'B':inputaccess:=bylevel;
  650.         'K':inputaccess:=keepout
  651.       end
  652.     end;
  653.  
  654.     procedure getallaccess;
  655.  
  656.       procedure setallaccess (ac:accesstype);
  657.       var cnt:integer;
  658.       begin
  659.         setalluserflags (urec,ac);
  660.         SendMsg ('Your access to all sub-boards: '+accessstr[ac]);
  661.         writeurec
  662.       end;
  663.  
  664.     begin
  665.       Write (Usr,'ALL acc. ([B]y level, [L]et in, [K]eep out, or CR): ');
  666.       Q:=ReadStri;
  667.       ac:=inputaccess(q);
  668.       if ac<>invalid then setallaccess(ac)
  669.     end;
  670.  
  671.   var bd:boardrec;
  672.   begin
  673.     ClearTop(7);
  674.     GotoXy(25,1);
  675.     WriteLn(Usr,'Change Sub-Board Access');
  676.     GotoXy(1,3);
  677.     Write(Usr,'Which Sub-Board to change access for [''*''/ALL]: ');
  678.     Bname:=ReadStri;
  679.     if length(bname)<1 then Begin FillScreen(1,1,80,24,white,blue,chr(176)); exit; End;
  680.     if bname='*' then
  681.       begin
  682.         getallaccess;
  683.         FillScreen(1,1,80,24,white,blue,chr(176));
  684.         main_choice:=1;
  685.         exit
  686.       end;
  687.     opentempbdfile;
  688.     bn:=searchboard(bname);
  689.     if bn=-1 then
  690.       begin
  691.         closetempbdfile;
  692.         Write(Usr,'No such board! Press any key..');
  693.         k:=bioskey;
  694.         FillScreen(1,1,80,24,white,blue,chr(176));
  695.         main_choice:=1;
  696.         exit
  697.       end;
  698.     writeln (Usr,'Board '+bname+'... Current access: '+accessstr[getuseraccflag(urec,bn)]);
  699.     Write(Usr,'Access ([B]y level, [L]et in, [K]eep out, or [CR]: ');
  700.     q:=readstri;
  701.     ac:=inputaccess(q);
  702.     if ac=invalid then begin
  703.       closetempbdfile;
  704.       FillScreen(1,1,80,24,white,blue,chr(176));
  705.       main_choice:=1;
  706.       exit
  707.     end;
  708.     setuseraccflag (urec,bn,ac);
  709.     writeurec;
  710.     closetempbdfile;
  711.     SendMsg ('New access for sub-board '+bname+': '+accessstr[ac]);
  712.     FillScreen(1,1,80,24,white,blue,chr(176));
  713.     main_choice:=1;
  714.   end;
  715.  
  716.   procedure getsysopaccess;
  717.   const sysopstr:array [false..true] of string[6]=('Normal','Sysop');
  718.         sectionnames:array [udsysop..databasesysop] of string[20]=
  719.           ('File transfer','Bulletin section','Voting booths',
  720.            'E-mail section','Doors','Main menu','Databases');
  721.   var cnt:configtype;
  722.       x:string[10];
  723.       n,mx:integer;
  724.       v:boolean;
  725.   begin
  726.     repeat
  727.       ClearTop(10);
  728.       GotoXy(1,1);
  729.       mx:=1;
  730.       for cnt:=udsysop to databasesysop do begin
  731.         write (usr,mx:3,'. ',sectionnames[cnt]);
  732.         mx:=mx+1;
  733.         gotoxy (25,wherey);
  734.         writeln (usr,sysopstr[cnt in urec.config])
  735.       end;
  736.       write (usr,^M^J'Number to toggle [CR to exit]: ');
  737.       readline (x);
  738.       n:=valu(x);
  739.       v:=(n>0) and (n<mx);
  740.       if v then begin
  741.         cnt:=configtype(ord(udsysop)+n-1);
  742.         if cnt in urec.config
  743.           then
  744.             begin
  745.               urec.config:=urec.config-[cnt];
  746.               x:='denied'
  747.             end
  748.           else
  749.             begin
  750.               urec.config:=urec.config+[cnt];
  751.               x:='granted'
  752.             end;
  753.         SendMsg ('You have been '+x+' sysop priveleges for the '+
  754.                  sectionnames[cnt]+'.')
  755.       end
  756.     until not v;
  757.     writeurec;
  758.     FillScreen(1,1,80,24,white,blue,chr(176));
  759.     main_choice:=1;
  760.   end;
  761.  
  762. Procedure Which_Flag;
  763. begin
  764.     Menu_Set(M1);
  765.     With M1 do
  766.     begin
  767.         Heading1 := '';
  768.         Heading2 := 'Confernce/Flag/Access Editing';
  769.         Topic[1] := '   Main Conference [1-5]';
  770.         Topic[2] := '   Access Flags [1-30]';
  771.         Topic[3] := '   Sub-Board Access (Msgs) ';
  772.         Topic[4] := '   SysOp Access Flags';
  773.         Topic[5] := '   Quit To Main SysOp Menu ';
  774.         TotalPicks := 5;
  775.         PicksPerLine := 1;            {one column of choices}
  776.         Addprefix := 1;               {add function key prefixes}
  777.         TopleftXY[1] := 5;            {system will center menu}
  778.         TopleftXY[2] := 6;           {Y coordinate}
  779.         Boxtype := 5;                 {fancy box}
  780.         If ColorScreen then
  781.         begin
  782.             Colors[1] := white;           {hi forground}
  783.             Colors[2] := magenta;            {hi background}
  784.             Colors[3] := lightgray;             {lo foreground}
  785.             Colors[4] := red;       {lo background}
  786.             Colors[5] := lightgray;            {box color}
  787.         end
  788.         else
  789.         begin
  790.             Colors[1] := white;           {hi forground}
  791.             Colors[2] := black;            {hi background}
  792.             Colors[3] := black;             {lo foreground}
  793.             Colors[4] := lightgray;       {lo background}
  794.             Colors[5] := white;            {box color}
  795.         end;
  796.         AllowEsc := false;            {inactivate the escape key}
  797.         Margins := 5;
  798. end;  {with M1 do}
  799. end; {Define_Menu1}
  800.  
  801. Begin
  802.     Quit:=False;
  803.     Findcursor(X,Y,ScanTop,ScanBot);
  804.     Main_Choice := 1;
  805.     Done:=False;
  806.     Buflen:=40;
  807.     repeat
  808.      Which_Flag;
  809.      DisplayMenu(M1,false,Main_Choice,Error);
  810.      Case Main_Choice of
  811.      1:GetMainConferences;
  812.      2:GetSubConferences;
  813.      3:GetNewAccess;
  814.      4:GetSysOpAccess;
  815.      5:Quit:=True;
  816.      end;  {case}
  817. until Quit;
  818. FillScreen(1,1,80,24,white,blue,chr(176));
  819. main_choice:=1;
  820. End;
  821.  
  822. Procedure Which_Other;
  823. begin
  824.     Menu_Set(M1);
  825.     With M1 do
  826.     begin
  827.         Heading1 := '';
  828.         Heading2 := 'Other SysOp Commands';
  829.         Topic[1] := '   Hang Up On User';
  830.         Topic[2] := '   Delete User (Nuke)';
  831.         Topic[3] := '   Snoop Mode [ON]';
  832.         Topic[4] := '   Snoop Mode [OFF]';
  833.         Topic[5] := '   Quit To Main SysOp Menu ';
  834.         TotalPicks := 5;
  835.         PicksPerLine := 1;            {one column of choices}
  836.         Addprefix := 1;               {add function key prefixes}
  837.         TopleftXY[1] := 28;           {system will center menu}
  838.         TopleftXY[2] := 13;           {Y coordinate}
  839.         Boxtype := 5;                 {fancy box}
  840.         If ColorScreen then
  841.         begin
  842.             Colors[1] := white;           {hi forground}
  843.             Colors[2] := magenta;            {hi background}
  844.             Colors[3] := lightgray;             {lo foreground}
  845.             Colors[4] := red;       {lo background}
  846.             Colors[5] := lightgray;            {box color}
  847.         end
  848.         else
  849.         begin
  850.             Colors[1] := white;           {hi forground}
  851.             Colors[2] := black;            {hi background}
  852.             Colors[3] := black;             {lo foreground}
  853.             Colors[4] := lightgray;       {lo background}
  854.             Colors[5] := white;            {box color}
  855.         end;
  856.         AllowEsc := false;            {inactivate the escape key}
  857.         Margins := 5;
  858. end;  {with M1 do}
  859. end; {Define_Menu1}
  860.  
  861. Procedure DoOther;
  862. Var Quit:Boolean;
  863. Begin
  864.     Quit:=False;
  865.     Findcursor(X,Y,ScanTop,ScanBot);
  866.     Main_Choice := 1;
  867.     Done:=False;
  868.     Buflen:=40;
  869.     repeat
  870.      Which_Other;
  871.      DisplayMenu(M1,false,Main_Choice,Error);
  872.      Case Main_Choice of
  873.      1:Begin
  874.          gotoxy(1,25);
  875.          Write('Sorry but the BBS is going down right now!');
  876.          ForceHangup:=True;
  877.          HangUp;
  878.         End;
  879.      2:Begin
  880.          Urec.Level:=-1;
  881.          gotoxy(1,25);
  882.          Write('You''re Nuked BUDDY!');
  883.          ForceHangup:=True;
  884.          HangUp;
  885.         End;
  886.      3:Begin
  887.          ModemInlock:=True;
  888.          SetOutLock(True);
  889.          gotoxy(1,25);
  890.          Sound(500);
  891.          NoSound;
  892.         End;
  893.      4:Begin
  894.         gotoxy(1,25);
  895.         Sound(250);
  896.         NoSound;
  897.         ModemInlock:=False;
  898.         SetOutLock(False);
  899.        End;
  900.      5:Quit:=True;
  901.      end;  {case}
  902. until Quit;
  903. FillScreen(1,1,80,24,white,blue,chr(176));
  904. main_choice:=1;
  905. End;
  906.  
  907. procedure gotodos (i:integer);
  908.   var status:word;
  909.       tmp1:integer;
  910.       st:mstr;
  911.   begin
  912.     gotoxy(1,25);
  913.     Write ('■ Sysop in DOS ■');
  914.     ansicolor(15);
  915.     window (1,1,80,25);
  916.     gotoxy (1,25);
  917.     writeln (usr,^M^J^J^J);
  918.     updateuserstats (false);
  919.     if i=1 then begin
  920.        textbackground(0);
  921.        clrscr; textcolor(15);
  922.        writeln(usr,'«« ViSiON Dos Shell »»');
  923.        writeln(usr,'Type ''EXIT'' to return.'^M);
  924.        tmp1:=timeleft;
  925.        if not configset.maximumdosshell then begin
  926.         swapvectors;
  927.         exec(getenv('COMSPEC'),'');
  928.         swapvectors;
  929.        End Else Begin
  930.          WriteLn(Usr,'Allocated ',bytesswapped,' bytes ',swaploc[EmsAllocated]);
  931.          SwapVectors;
  932.          Status:=ExecWithSwap(GetEnv('Comspec'),'');
  933.          SwapVectors;
  934.         End;
  935.        st:=configset.forumdi;
  936.        if st[length(st)]='\' then st[length(st)]:=#0;
  937.        chdir(st);
  938.        settimeleft(tmp1);
  939.        bottomline;
  940.        end else if i=2 then begin
  941.      ensureclosed;
  942.      writereturnbat;
  943.      closeport;
  944.      halt (4);
  945.     end;
  946.     Textbackground(0);
  947.     ClrScr;
  948.     FillScreen(1,1,80,24,white,blue,chr(176));
  949.   end;
  950.  
  951. procedure runconfig;
  952. var status:word;
  953. begin
  954.  if configset.forumdi[length(configset.forumdi)]<>'\' then configset.forumdi:=configset.forumdi+'\';
  955.  swapvectors;
  956.  exec(getenv('COMSPEC'), '/C CONFIG.EXE');
  957.  swapvectors;
  958.  readconfig;
  959.  FillScreen(1,1,80,24,white,blue,chr(176));
  960. end;
  961.  
  962. procedure dotexteditor;
  963.   begin
  964.     if length(configset.edito)<1 then exit;
  965.     window (1,1,80,25);
  966.     gotoxy (1,25);
  967.     writeln (usr,^M^J^J^J);           updateuserstats (false);
  968.     exec(GetEnv('COMSPEC'), '/C '+configset.edito);
  969.     FillScreen(1,1,80,24,white,blue,chr(176));
  970.   end;
  971.  
  972.  
  973. Procedure Which_SysOp;
  974. begin
  975.     Menu_Set(M1);
  976.     With M1 do
  977.     begin
  978.         Heading1 := 'ViSiON v0.82 By: Crimson Blade';
  979.         Heading2 := 'Online SysOp Commands';
  980.         Topic[1] := '   ViSiON SysOp User Editor ';
  981.         Topic[2] := '   Set User Access Flags';
  982.         Topic[3] := '   Other Commands';
  983.         Topic[4] := '   Shell To DOS';
  984.         Topic[5] := '   Full Drop To DOS';
  985.         Topic[6] := '   Run Configuration Program ';
  986.         Topic[7] := '   Run Text Editor';
  987.         Topic[8] := '   Chat Commands';
  988.         Topic[9] := '   Quit SysOp Commands';
  989.         TotalPicks := 9;
  990.         PicksPerLine := 1;            {one column of choices}
  991.         Addprefix := 1;               {add function key prefixes}
  992.         TopleftXY[1] := 0;            {system will center menu}
  993.         TopleftXY[2] := 4;            {Y coordinate}
  994.         Boxtype := 5;                 {fancy box}
  995.         If ColorScreen then
  996.         begin
  997.             Colors[1] := white;           {hi forground}
  998.             Colors[2] := magenta;            {hi background}
  999.             Colors[3] := lightgray;             {lo foreground}
  1000.             Colors[4] := blue;       {lo background}
  1001.             Colors[5] := lightgray;            {box color}
  1002.         end
  1003.         else
  1004.         begin
  1005.             Colors[1] := white;           {hi forground}
  1006.             Colors[2] := black;            {hi background}
  1007.             Colors[3] := black;             {lo foreground}
  1008.             Colors[4] := lightgray;       {lo background}
  1009.             Colors[5] := white;            {box color}
  1010.         end;
  1011.         AllowEsc := false;            {inactivate the escape key}
  1012.         Margins := 5;
  1013. end;  {with M1 do}
  1014. end; {Define_Menu1}
  1015.  
  1016. Begin
  1017.     WriteLn(^R'■ '^A'One Moment'^R' ■');
  1018.     SplitScreen(25);
  1019.     Activate_Visible_Screen;
  1020.     textbackground(0);
  1021.     Clrscr;
  1022.     FillScreen(1,1,80,24,white,blue,chr(176));
  1023.     Findcursor(X,Y,ScanTop,ScanBot);
  1024.     OffCursor;
  1025.     Main_Choice := 1;
  1026.     Done:=False;
  1027.     Buflen:=40;
  1028.     Textbackground(0);
  1029.     repeat
  1030.      Which_SysOp;
  1031.      DisplayMenu(M1,false,Main_Choice,Error);
  1032.      Case Main_Choice of
  1033.      1:Begin ClrScr; DoUserEditing; End;
  1034.      2:Begin DoAccessFlags; End;
  1035.      3:Begin DoOther; End;
  1036.      4:Begin ClrScr; Gotodos(1); End;
  1037.      5:Begin ClrScr; Gotodos(2); End;
  1038.      6:Begin ClrScr; RunConfig; End;
  1039.      7:Begin ClrScr; DoTextEditor; End;
  1040.      8:Begin Done:=True; BustChat; Done:=True; End;
  1041.      9:Done:=True;
  1042.      end;  {case}
  1043. until Done;
  1044. OnCursor;
  1045. ClrScr;
  1046. UnSplit;
  1047. Main_Choice:=1;
  1048. End;
  1049.  
  1050. procedure specialseries;
  1051. begin
  1052.   repeat until specialcommand
  1053. end;
  1054.  
  1055. procedure chat (gotospecial,color:boolean);
  1056. var k:char;
  1057.     StartedTime:Word;
  1058.     cnt,displaywid:integer;
  1059.     quit,carrierloss,fromkbd:boolean;
  1060.     baudstr,commstr:mstr;
  1061.     c1,c2,c3,c4,c5,c6,c7,c8,backup:integer;
  1062.  
  1063.  
  1064.     xsys     :byte;
  1065.     ysys     :byte;
  1066.     xusr     :byte;
  1067.     yusr     :byte;
  1068.     curcolor :byte;
  1069.     ec       :byte;
  1070.     initi    :boolean;
  1071.     linebufs :string[80];
  1072.     linebufu :string[80];
  1073.  
  1074. procedure init;
  1075. begin
  1076.   xsys     :=1;
  1077.   ysys     :=14;
  1078.   xusr     :=1;
  1079.   yusr     :=4;
  1080.   curcolor :=1;
  1081.   ec       :=1;
  1082.   initi    :=true;
  1083.   linebufs :='';
  1084.   linebufu :='';
  1085.   inuse:=2;
  1086. end;
  1087.  
  1088.  
  1089. procedure sendxy (x,y:byte);
  1090. begin
  1091.  write(#27+'[',y,';',x,'H');
  1092.  
  1093. end;
  1094.  
  1095.  
  1096. Procedure clearscre;
  1097.  var i:byte;
  1098.  begin
  1099.  for I:=4 to 23 do
  1100.   begin
  1101.    sendxy(1,i);
  1102.    write(#27'[K');
  1103.    end;
  1104.  end;
  1105.  
  1106.  
  1107. Procedure setc;
  1108. begin
  1109.    if fromkbd then ec:=urec.statcolor else ec:=urec.inputcolor;
  1110.    if curcolor<>ec then begin
  1111.    curcolor:=ec;
  1112.   end;
  1113. end;
  1114.  
  1115.  
  1116. procedure midline;
  1117.  begin
  1118.    sendxy(1,13);
  1119.    write(^R'───────────────────────────'^S' '^P'ViSiON '+versionnum+' - '+timestr(now)+^R);
  1120.    write(' ───────────────────────────');
  1121.    sendxy(trunc((21-length(configset.sysopnam))/2),13);
  1122.    write (^R'─ '^S+configset.sysopnam+^R' ─');
  1123.    sendxy(trunc((24-length(urec.handle))/2)+52,13);
  1124.    write (^R'─ '^S+urec.handle+^R' ─');
  1125.  end;
  1126.  
  1127. Procedure cle (malig:byte);
  1128. var i    :byte;
  1129. begin
  1130. if malig=0 then
  1131. begin
  1132.   for i:=14 to 23 do
  1133.  begin
  1134.     sendxy(1,i);
  1135.         ansicolor(1);
  1136.     write(#27'[K');
  1137.  end;
  1138.  sendxy(1,14);
  1139.  malig:=0;
  1140. end;
  1141.  
  1142. if malig=1 then
  1143. begin
  1144.     for i:=4 to 12 do
  1145.  begin
  1146.   sendxy(1,i);
  1147.   ansicolor(1);
  1148.   write(#27,'[K');
  1149.  end;
  1150.  sendxy(1,4);
  1151.  malig:=0;
  1152. end;
  1153.  
  1154.  
  1155.  
  1156. end;
  1157.  
  1158.   procedure wordwrapit(yeanea:byte);
  1159.   var cnt       :byte;
  1160.       wl        :integer;
  1161.       ww        :lstr;
  1162.       cutarea   :byte;
  1163.       done      :boolean;
  1164.   begin
  1165.    done:=false;
  1166.    cutarea:=0;
  1167.    ww:='';
  1168.    cnt:=80;
  1169.    if yeanea=0 then
  1170.      begin
  1171.       If Pos(' ',LineBufs)<=0 then Begin
  1172.         Writeln;
  1173.         LineBufs:='';
  1174.         Xsys:=1;
  1175.         Inc(Ysys);
  1176.         Exit;
  1177.       End;
  1178.     repeat
  1179.       if not done and (copy(linebufs,cnt,1)=' ') then cutarea:=cnt;
  1180.       if (cutarea>0) and not done then
  1181.         begin
  1182.         ww:=copy(linebufs,cnt+1,255);
  1183.          ansicolor(urec.statcolor);
  1184.          sendxy(cutarea,ysys);
  1185.          write(#27'[K');
  1186.          inc(ysys);
  1187.          xsys:=1;
  1188.          sendxy(xsys,ysys);
  1189.          write(copy(linebufs,cutarea+1,80-cutarea));
  1190.          xsys:=length(copy(linebufs,cutarea+1,80-cutarea))+1;
  1191.          sendxy(xsys,ysys);
  1192.          dec(ysys);
  1193.          done:=true
  1194.         end;
  1195.       dec(cnt);
  1196.      until cnt=1;
  1197.     linebufs:=ww;
  1198.    end;
  1199.  
  1200.    if yeanea=1 then
  1201.    begin
  1202.     If Pos(' ',LineBufu)<=0 then Begin
  1203.        Writeln;
  1204.        Inc(Yusr);
  1205.        Xusr:=0;
  1206.        LineBufu:='';
  1207.        Exit;
  1208.     End;
  1209.    done:=false;
  1210.    cutarea:=0;
  1211.    ww:='';
  1212.    cnt:=80;
  1213.     repeat
  1214.       if not done and (copy(linebufu,cnt,1)=' ') then cutarea:=cnt;
  1215.       if (cutarea>0) and not done then
  1216.         begin
  1217.         ww:=copy(linebufu,cnt+1,255);
  1218.          ansicolor(urec.inputcolor);
  1219.          sendxy(cutarea,yusr);
  1220.          write(#27'[K');
  1221.          inc(yusr);
  1222.          xusr:=1;
  1223.          sendxy(xusr,yusr);
  1224.          write(copy(linebufu,cutarea+1,80-cutarea));
  1225.          xusr:=length(copy(linebufu,cutarea+1,80-cutarea))+1;
  1226.          sendxy(xusr,yusr);
  1227.          dec(yusr);
  1228.          done:=true
  1229.         end;
  1230.       dec(cnt);
  1231.      until cnt=1;
  1232.     linebufu:=ww;
  1233.    end;
  1234. end;
  1235.  
  1236.  
  1237.  Procedure locate;
  1238.  begin
  1239.    if fromkbd then
  1240.  begin
  1241.  
  1242.      if (xsys=80) and (ysys<23) then
  1243.     begin
  1244.      wordwrapit(0);
  1245.      inc(ysys);
  1246.     end;
  1247.     if ((ysys=23) and (xsys=80)) or (ysys>23) then
  1248.     begin
  1249.     cle(0);
  1250.     ysys:=14;
  1251.     xsys:=1;
  1252.     sendxy(xsys,ysys);
  1253.     ansicolor(urec.statcolor);
  1254.     write(^S+linebufs);
  1255.         ansireset;
  1256.     sendxy(80-length(linebufs)+1,ysys);
  1257.         ansireset;
  1258.     wordwrapit(0);
  1259.     inc(ysys);
  1260.     sendxy(xsys,ysys);
  1261.  end;
  1262.  
  1263.   sendxy(xsys,ysys);
  1264.   inc(xsys);
  1265.  end;
  1266.    if not fromkbd then
  1267.  begin
  1268.    if (xusr=80) and (yusr<12) then
  1269.   begin
  1270.    wordwrapit(1);
  1271.    inc(yusr);
  1272.   end;
  1273. if ((yusr=12) and (xusr=80)) or (yusr>12) then
  1274.  begin
  1275.    cle(1);
  1276.    yusr:=4;
  1277.    xusr:=1;
  1278.    sendxy(xusr,yusr);
  1279.    ansicolor(urec.inputcolor);
  1280.    write(^U+linebufu);
  1281.    ansireset;
  1282.    sendxy(80-length(linebufu)+1,yusr);
  1283.    ansireset;
  1284.    wordwrapit(1);
  1285.    inc(yusr);
  1286.    sendxy(xusr,yusr);
  1287.  end;
  1288.  
  1289.    sendxy(xusr,yusr);
  1290.    inc(xusr);
  1291.  end;
  1292. end;
  1293.  
  1294.   procedure instruct;
  1295.   var i:integer;
  1296.   begin
  1297.  for i:=1 to 5 do
  1298.    begin
  1299.      sendxy(1,i);
  1300.      write(#27,'[K');
  1301.      end;
  1302.      splitscreen (2);
  1303.     top;
  1304.     clrscr;
  1305.     write (usr,'Now in Chat mode. Press [F1] to leave or [F2] for commands.');
  1306.     initi:=false;
  1307.     bottom;
  1308.     sendxy(1,4);
  1309.   end;
  1310.  
  1311.   Procedure ChangeVars;
  1312.       Begin
  1313.        backup:=c1;
  1314.        c1:=c2; c2:=c3; c3:=c4; c4:=c5; c5:=c6; c6:=c7; c7:=c8; c8:=backup;
  1315.        ansicolor(c1);
  1316.       End;
  1317.  
  1318.     Procedure GetCrazyVars;
  1319.       Begin
  1320.        If Color Then Begin
  1321.        c1:=configset.kkk1; c2:=configset.kkk2; c3:=configset.kkk3;
  1322.        c4:=configset.kkk4; c5:=configset.kkk5; c6:=configset.kkk6;
  1323.        c7:=configset.kkk7; c8:=configset.kkk8;
  1324.       End Else Begin
  1325.        c1:=urec.inputcolor;
  1326.        End;
  1327.       End;
  1328.  
  1329.  
  1330. procedure typedchar (k:char);
  1331.  
  1332.    begin
  1333.    ChangeVars;
  1334.    locate;
  1335.    begin;
  1336.    If (c1<1) and (c1>15) then getcrazyvars;
  1337.    if fromkbd then begin If Color then ansicolor(c1) else ansicolor(urec.statcolor); linebufs:=linebufs+K;
  1338.    end;
  1339.    if not fromkbd then begin If Color then ansicolor(c1) else ansicolor(urec.inputcolor); linebufu:=linebufu+K;
  1340.    end;
  1341.     write(k)
  1342.    end;
  1343.   end;
  1344.  
  1345.  
  1346. begin
  1347.   carrierloss:=false;
  1348.   chatmode:=false;
  1349.   writeln (^B^M);
  1350.   if wanted in urec.config then begin
  1351.     specialmsg ('(No longer wanted)');
  1352.     urec.config:=urec.config-[wanted];
  1353.     writeurec;
  1354.   end;
  1355.   if eightycols in urec.config then displaywid:=80 else displaywid:=40;
  1356.   if gotospecial then begin
  1357.     specialseries;
  1358.     exit
  1359.   end;
  1360.   clearbreak;
  1361.   nobreak:=true;
  1362.   writeln (^M^M,configset.entercha,^M^R);
  1363.   StartedTime:=TimeLeft;
  1364.   instruct;
  1365.   if not initi then
  1366. begin
  1367.   CLEARSCRE;
  1368.   Sendxy(1,13); ANSiCOLOR(15);
  1369.   WriteLn('                          ViSiON 2/Way Chat v0.82'); Delay(100);
  1370.   Sendxy(1,13); ANSiCOLOR(7);
  1371.   WriteLn('                          ViSiON 2/Way Chat v0.82'); Delay(100);
  1372.   Sendxy(1,13); ANSiCOLOR(8);
  1373.   WriteLn('                          ViSiON 2/Way Chat v0.82'); Delay(100);
  1374.    if color then GetCrazyVars;
  1375.    init;
  1376.    clearscre;
  1377.    midline;
  1378. end;
  1379.  
  1380.   quit:=false;
  1381.   nobreak:=true;
  1382.   break:=false;
  1383.   repeat
  1384.     linecount:=0;
  1385.     if (not carrierloss) and (not carrier) then begin
  1386.       carrierloss:=true;
  1387.       gotoxy(1,4);
  1388.       writeln (^M'Warning: There is no carrier present.'^M)
  1389.  
  1390.     end;
  1391.     repeat until keyhit or (carrier and (numchars>0));
  1392.     fromkbd:=keyhit;
  1393.     ingetstr:=true;
  1394.     if fromkbd then
  1395.      k:=bioskey else
  1396.     k:=getchar;
  1397.     if k=#127 then k:=#8;
  1398.     if k > #127 then if ((ord(k) - 128) in [59,60]) then begin
  1399.       if (ord(k) - 128) = 60 then begin
  1400.         quit:=specialcommand;
  1401.         if not quit then instruct;
  1402.         clearbreak;
  1403.         unsplit;
  1404.       end;
  1405.       nobreak:=true;
  1406.       writeln (^M^M,configset.exitcha,^M^R);
  1407.       SetTimeLeft(StartedTime);
  1408.       write (#27'[J');
  1409.       bottomline;
  1410.       chainstr:='';
  1411.       input:='';
  1412.       write (lastprompt);
  1413.       exit;
  1414.     end;
  1415.     case ord(k) of
  1416.       8:begin
  1417.       if (xsys>1) and fromkbd then
  1418.        begin
  1419.           modeminlock:=true;
  1420.           if xsys>1 then dec(xsys);
  1421.           sendxy(xsys,ysys);
  1422.           write (' ');
  1423.           sendxy(xsys,ysys);
  1424.           if length(linebufs)>0 then linebufs:=copy(linebufs,1,length(linebufs)-1);
  1425.           modeminlock:=false;
  1426.         end;
  1427.       if (xusr>1) and not fromkbd then
  1428.        begin
  1429.           modeminlock:=true;
  1430.           if xusr>1 then dec(xusr);
  1431.           sendxy(xusr,yusr);
  1432.           write (' ');
  1433.           sendxy(xsys,ysys);
  1434.           if length(linebufu)>0 then linebufu:=copy(linebufu,1,length(linebufu)-1);
  1435.           modeminlock:=false;
  1436.         end;
  1437.      end;
  1438.       0:;
  1439.       13:begin
  1440.            writeln;
  1441.            bottomline;
  1442.           if fromkbd then begin
  1443.            xsys:=1;
  1444.            inc(ysys);
  1445.        if (ysys>=21) then
  1446.          begin
  1447.           cle(0);
  1448.            ysys:=14;
  1449.            xsys:=1;
  1450.            sendxy(xsys,ysys);
  1451.            ansicolor(urec.statcolor);
  1452.            write(linebufs);
  1453.            ysys:=15;
  1454.            xsys:=1;
  1455.            end;
  1456.            sendxy(xsys,ysys);
  1457.            linebufs:='';
  1458.            end;
  1459.  
  1460.           if not fromkbd then begin
  1461.            xusr:=1;
  1462.            inc(yusr);
  1463.        if (yusr=13) then
  1464.               begin
  1465.                  cle(1);
  1466.                   yusr:=4;
  1467.                   xusr:=1;
  1468.                    ansicolor(urec.inputcolor);
  1469.                   sendxy(xusr,yusr);
  1470.                   write(linebufu);
  1471.                   yusr:=5;
  1472.                   sendxy(xusr,yusr);
  1473.               end;
  1474.             sendxy(xusr,yusr);
  1475.           linebufu:='';
  1476.           end;
  1477.          end;
  1478.       32..255:typedchar (k);
  1479.       1..31:if fromkbd and carrier then sendchar(k);
  1480.     end
  1481.   until quit;
  1482.   clearbreak
  1483. end;
  1484.  
  1485.  
  1486. Procedure OnelineChat;
  1487. VAR k:char;
  1488.     cnt,displaywid:integer;
  1489.     StartedTime:Word;
  1490.     quit,carrierloss,fromkbd:boolean;
  1491.     linebuffer:lstr;
  1492.     l:byte absolute linebuffer;
  1493.     curcolor:byte;
  1494.  
  1495.   Procedure instruct;
  1496.   begin
  1497.     splitscreen (3);
  1498.     top;
  1499.     clrscr;
  1500.     write (usr,'Now in chat mode.  Press <F1> to leave or <F2> for commands.');
  1501.     bottom
  1502.   end;
  1503.  
  1504.   Procedure wordwrap;
  1505.   VAR cnt,wl:integer;
  1506.       ww:lstr;
  1507.   begin
  1508.     ww:='';
  1509.     cnt:=displaywid;
  1510.     while (cnt>0) and (linebuffer[cnt]<>' ') do cnt:=cnt-1;
  1511.     if cnt=0 then ww:=k else begin
  1512.       ww:=copy(linebuffer,cnt+1,255);
  1513.       wl:=length(ww)-1;
  1514.       if wl>0 then begin
  1515.         for cnt:=1 to wl do write (^H);
  1516.         for cnt:=1 to wl do write (' ')
  1517.       end
  1518.     end;
  1519.     writeln;
  1520.     ansicolor (curcolor);
  1521.     write (ww);
  1522.     linebuffer:=ww
  1523.   end;
  1524.  
  1525.   Procedure typedchar (k:char);
  1526.   VAR ec:byte;
  1527.   begin
  1528.     l:=l+1;
  1529.     linebuffer[l]:=k;
  1530.     if l=displaywid then wordwrap else write(k)
  1531.   end;
  1532.  
  1533. VAR Ch : CHAR;
  1534.     inchat:boolean;
  1535. begin
  1536.   While Keypressed DO
  1537.     Ch := ReadKey;
  1538.   Writeln(^M);
  1539.   carrierloss := false;
  1540.   chatmode := false;
  1541.   InChat := TRUE;
  1542.   writeln(^B);
  1543.   if (wanted in urec.config) AND (Ulvl < 90)  then begin
  1544.     specialmsg ('(No longer wanted)');
  1545.     urec.config:=urec.config-[wanted];
  1546.     writeurec;
  1547.   end;
  1548.   if eightycols in urec.config then displaywid:=80 else displaywid:=40;
  1549.   if length(chatreason)>0 then specialmsg ('(Chat reason: '+chatreason+')');
  1550.   chatreason:='';
  1551.   clearbreak;
  1552.   nobreak := TRUE;
  1553.   Writeln (^M^M^R,configset.entercha,^M^M);
  1554.   StartedTime:=TimeLeft;
  1555.   instruct;
  1556.   quit:=false;
  1557.   l:=0;
  1558.   curcolor:=urec.regularcolor;
  1559.   nobreak:=true;
  1560.   repeat
  1561.     linecount:=0;
  1562.     if (not carrierloss) and (not carrier) then begin
  1563.       carrierloss:=true;
  1564.       writeln (^M'Warning: No Carrier detected.'^M)
  1565.     end;
  1566.     repeat until keyhit or (carrier and (numchars>0));
  1567.     fromkbd:=keyhit;
  1568.     ingetstr:=true;
  1569.     curcolor:=urec.inputcolor;
  1570.     if not keyhit then read(directin,k) else begin curcolor:=urec.statcolor;
  1571.     K:=bioskey;
  1572.     if (ord(k)>127) then if ((ord(k)-128)=chatchar) then inchat:=false;
  1573.     if (ord(k)>127) then if ((ord(k)-129)=chatchar) then begin specialseries;
  1574.     inchat:=false;
  1575.     end;
  1576.     end;
  1577.     ansicolor(curcolor);
  1578.     if k=#127 then k:=#8;
  1579.     Quit := NOT Inchat;
  1580.     if quit then k:=#0;
  1581.     case ord(k) of
  1582.       8:if l>0 then begin
  1583.           write (k+' '+k);
  1584.           l:=l-1
  1585.         end;
  1586.       0:;
  1587.       13:begin
  1588.            writeln;
  1589.            bottomline;
  1590.            l:=0
  1591.          end;
  1592.       32..255:typedchar (k);
  1593.       1..31:if fromkbd and carrier then sendchar(k)
  1594.     end
  1595.   until quit;
  1596.   chainstr:='';
  1597.   input:='';
  1598.   UnSplit;
  1599.   ClearBreak;
  1600.   Writeln(^M^M^R,configset.exitcha,^M);
  1601.   SetTimeLeft(StartedTime);
  1602.   bottomline;
  1603. End;
  1604.  
  1605. procedure regchat(color:Boolean); (* Vertical Chat *)
  1606. var k:char;
  1607.     StartedTime:Word;
  1608.     cnt,displaywid:integer;
  1609.     quit,carrierloss,fromkbd:boolean;
  1610.     baudstr,commstr:mstr;
  1611.     c1,c2,c3,c4,c5,c6,c7,c8,backup:integer;
  1612.  
  1613.  
  1614.     xsys     :byte;
  1615.     ysys     :byte;
  1616.     xusr     :byte;
  1617.     yusr     :byte;
  1618.     curcolor :byte;
  1619.     ec       :byte;
  1620.     initi    :boolean;
  1621.     linebufs :string[38];
  1622.     linebufu :string[38];
  1623.  
  1624. procedure init;
  1625. begin
  1626.   xsys     :=1;
  1627.   ysys     :=5;
  1628.   xusr     :=42;
  1629.   yusr     :=5;
  1630.   curcolor :=1;
  1631.   ec       :=1;
  1632.   initi    :=true;
  1633.   linebufs :='';
  1634.   linebufu :='';
  1635.   inuse:=2;
  1636. end;
  1637.  
  1638.  
  1639. procedure sendxy (x,y:byte);
  1640. begin
  1641.  write(#27+'[',y,';',x,'H');
  1642. end;
  1643.  
  1644.  
  1645. Procedure clearscre;
  1646.  var i:byte;
  1647.  begin
  1648.  for I:=1 to 24 do
  1649.   begin
  1650.    sendxy(1,i);
  1651.    write(#27'[K');
  1652.    end;
  1653.  end;
  1654.  
  1655.  
  1656. Procedure setc;
  1657. begin
  1658.    if fromkbd then ec:=urec.statcolor else ec:=urec.inputcolor;
  1659.    if curcolor<>ec then begin
  1660.    curcolor:=ec;
  1661.   end;
  1662. end;
  1663.  
  1664.  procedure midline;
  1665.  var i:byte;
  1666.  begin
  1667.    unsplit;
  1668.    clearscre;
  1669.    ClearScr;
  1670.    sendxy(1,2);
  1671.    write(^P'───────────────────────────────────────┬──────────────────────────────────────');
  1672.    sendxy(trunc((21-length(configset.sysopnam))/2),1);
  1673.    write (^A'■ '^S+configset.sysopnam+^A' ■');
  1674.    sendxy(trunc((24-length(urec.handle))/2)+52,1);
  1675.    write (^A'■ '^S+urec.handle+^A' ■');
  1676.    sendxy(1,3); ansicolor(31);
  1677.    Write('  ViSiON Vertical Split Screen Chat   ');
  1678.    sendxy(42,3); ansicolor(31);
  1679.    Write('  ViSiON Vertical Split Screen Chat  ');
  1680.    For i:=3 to 23 Do Begin
  1681.    Sendxy(40,i);
  1682.    Write(^P'│');
  1683.  end;
  1684. End;
  1685.  
  1686. Procedure cle (malig:byte);
  1687. var i,x    :byte;
  1688.  
  1689. begin
  1690. if malig=0 then
  1691. begin
  1692.    for i:=4 to 22 do
  1693.  begin
  1694.     sendxy(1,i);
  1695.   write('                                      ');
  1696.  end;
  1697.  sendxy(1,4);
  1698.  malig:=0;
  1699. end;
  1700.  
  1701. if malig=1 then
  1702. begin
  1703.   for i:=4 to 22 do
  1704.  begin
  1705.   sendxy(42,i);
  1706.   write('                                     ');
  1707.  end;
  1708.  sendxy(42,4);
  1709.  malig:=0;
  1710. end;
  1711. end;
  1712.  
  1713.   procedure wordwrapit(yeanea:byte);
  1714.   var cnt       :byte;
  1715.       wl        :integer;
  1716.       ww        :lstr;
  1717.       cutarea   :byte;
  1718.       done      :boolean;
  1719.   begin
  1720.    done:=false;
  1721.    cutarea:=0;
  1722.    ww:='';
  1723.    cnt:=80;
  1724.    if yeanea=0 then
  1725.      begin
  1726.       If Pos(' ',LineBufs)<=0 then Begin
  1727.         Writeln;
  1728.         LineBufs:='';
  1729.         Xsys:=1;
  1730.         Inc(Ysys);
  1731.         Exit;
  1732.       End;
  1733.     repeat
  1734.       if not done and (copy(linebufs,cnt,1)=' ') then cutarea:=cnt;
  1735.       if (cutarea>0) and not done then
  1736.         begin
  1737.         ww:=copy(linebufs,cnt+1,255);
  1738.          ansicolor(urec.statcolor);
  1739.          sendxy(cutarea,ysys);
  1740. (*         write('                                    '); *)
  1741.          inc(ysys);
  1742.          xsys:=1;
  1743.          sendxy(xsys,ysys);
  1744.          write(copy(linebufs,cutarea+1,80-cutarea));
  1745.          xsys:=length(copy(linebufs,cutarea+1,80-cutarea))+1;
  1746.          sendxy(xsys,ysys);
  1747.          dec(ysys);
  1748.          done:=true
  1749.         end;
  1750.       dec(cnt);
  1751.      until cnt=1;
  1752.     linebufs:=ww;
  1753.    end;
  1754.  
  1755.    if yeanea=1 then
  1756.    begin
  1757.     If Pos(' ',LineBufu)<=0 then Begin
  1758.        Inc(Yusr);
  1759.        Xusr:=42;
  1760.        LineBufu:='';
  1761.        sendxy (xusr,yusr);
  1762.        Exit;
  1763.     End;
  1764.    done:=false;
  1765.    cutarea:=0;
  1766.    ww:='';
  1767.    cnt:=80;
  1768.     repeat
  1769.       if not done and (copy(linebufu,cnt,1)=' ') then cutarea:=cnt;
  1770.       if (cutarea>0) and not done then
  1771.         begin
  1772.         ww:=copy(linebufu,cnt+1,255);
  1773.          ansicolor(urec.inputcolor);
  1774. (*         sendxy(cutarea,yusr);
  1775.          write('                                    '); *)
  1776.          inc(yusr);
  1777.          xusr:=42;
  1778.          sendxy(xusr,yusr);
  1779. (*         write(copy(linebufu,cutarea+1,80-cutarea+40)); *)
  1780.          sendxy(42,yusr);
  1781.          write(linebufu);
  1782.          xusr:=length(copy(linebufu,cutarea+1,80-cutarea))+1; (* Added +40 *)
  1783.          sendxy(xusr,yusr);
  1784.          dec(yusr);
  1785.          done:=true
  1786.         end;
  1787.       dec(cnt);
  1788.      until cnt=1;
  1789.     linebufu:=ww;
  1790.    end;
  1791. end;
  1792.  
  1793.  
  1794.  Procedure locate;
  1795.  begin
  1796.    if fromkbd then begin
  1797.      if (xsys=39) and (ysys<22) then begin
  1798.     {  wordwrapit(0); }
  1799.        xsys:=1;
  1800.        inc(ysys);
  1801.      end;
  1802.      if ((ysys=22) and (xsys=39)) or (ysys=22) then begin
  1803.        cle(0);
  1804.        ysys:=4;
  1805.        xsys:=1;
  1806.        sendxy(xsys,ysys);
  1807.        write(^S+linebufs);
  1808.        sendxy(80-length(linebufs)+1,ysys);
  1809.     {  wordwrapit(0); }
  1810.        ysys:=5;
  1811.        sendxy(xsys,ysys);
  1812.      end;
  1813.      sendxy(xsys,ysys);
  1814.      inc(xsys);
  1815.    end else begin
  1816.      if (xusr=77) and (yusr<22) then begin
  1817.      { wordwrapit(1); }
  1818.        xusr:=42;
  1819.        inc(yusr);
  1820.      end;
  1821.      if ((yusr=22) and (xusr=77)) or (yusr=22) then begin
  1822.        cle(1);
  1823.        yusr:=4;
  1824.        xusr:=42;
  1825.        sendxy(xusr,yusr);
  1826.        ansicolor(urec.inputcolor);
  1827.        write(linebufu);
  1828.        sendxy(80-length(linebufu)+41,yusr);
  1829.      { wordwrapit(1); }
  1830.        yusr:=5;
  1831.        sendxy(xusr,yusr);
  1832.      end;
  1833.      sendxy(xusr,yusr);
  1834.      inc(xusr);
  1835.    end;
  1836.  end;
  1837.  
  1838.   procedure instruct;
  1839.   var i:integer;
  1840.   begin
  1841.   If initi then begin
  1842.     initi:=false;
  1843.     sendxy(1,4);
  1844.   end else
  1845.   end;
  1846.  
  1847.   Procedure ChangeVars;
  1848.       Begin
  1849.        backup:=c1;
  1850.        c1:=c2; c2:=c3; c3:=c4; c4:=c5; c5:=c6; c6:=c7; c7:=c8; c8:=backup;
  1851.        ansicolor(c1);
  1852.       End;
  1853.  
  1854.     Procedure GetCrazyVars;
  1855.       Begin
  1856.        If Color Then Begin
  1857.        c1:=configset.kkk1; c2:=configset.kkk2; c3:=configset.kkk3;
  1858.        c4:=configset.kkk4; c5:=configset.kkk5; c6:=configset.kkk6;
  1859.        c7:=configset.kkk7; c8:=configset.kkk8;
  1860.       End Else Begin
  1861.        c1:=urec.inputcolor;
  1862.        End;
  1863.       End;
  1864.  
  1865.  
  1866. procedure typedchar (k:char);
  1867. begin
  1868.   ChangeVars;
  1869.   locate;
  1870.   If (c1<1) and (c1>15) then getcrazyvars;
  1871.   if fromkbd then begin
  1872.     If Color then ansicolor(c1) else ansicolor(urec.promptcolor);
  1873.     linebufs:=linebufs+K;
  1874.   end else begin
  1875.     If Color then ansicolor(c1) else ansicolor(urec.inputcolor);
  1876.     linebufu:=linebufu+K;
  1877.   end;
  1878.   write(k)
  1879. end;
  1880.  
  1881. begin
  1882.   carrierloss:=false;
  1883.   chatmode:=false;
  1884.   writeln (^B^M);
  1885.   if wanted in urec.config then begin
  1886.     specialmsg ('(No longer wanted)');
  1887.     urec.config:=urec.config-[wanted];
  1888.     writeurec;
  1889.   end;
  1890.   if eightycols in urec.config then displaywid:=80 else displaywid:=40;
  1891.   clearbreak;
  1892.   nobreak:=true;
  1893.   writeln (^M^M,configset.entercha,^M^R);
  1894.   StartedTime:=TimeLeft;
  1895.   instruct;
  1896.   if not initi then
  1897. begin
  1898.    CLEARSCRE;
  1899.   sendXY(1,13); ANSiCOLOR(15);
  1900.   WriteLn('                          ViSiON 2/Way Chat v0.82'); Delay(100);
  1901.   sendXy(1,13); ANSiCOLOR(7);
  1902.   WriteLn('                          ViSiON 2/Way Chat v0.82'); Delay(100);
  1903.   sendXy(1,13); ANSiCOLOR(8);
  1904.   WriteLn('                          ViSiON 2/Way Chat v0.82'); Delay(100);
  1905.    if color then GetCrazyVars;
  1906.    init;
  1907.    clearscre;
  1908.    midline;
  1909. end;
  1910.  
  1911.   quit:=false;
  1912.   nobreak:=true;
  1913.   break:=false;
  1914.   repeat
  1915.     linecount:=0;
  1916.     if (not carrierloss) and (not carrier) then begin
  1917.       carrierloss:=true;
  1918. (*      gotoxy(1,4);
  1919.       writeln (^M'Warning: There is no carrier present.'^M) *)
  1920.     end;
  1921.     repeat until keyhit or (carrier and (numchars>0));
  1922.     fromkbd:=keyhit;
  1923.     ingetstr:=true;
  1924.     if fromkbd then
  1925.      k:=bioskey else
  1926.     k:=getchar;
  1927.     if k=#127 then k:=#8;
  1928.     if k > #127 then if ((ord(k) - 128) in [60,61]) then begin
  1929.       if (ord(k) - 128) = 60 then begin
  1930.         quit:=specialcommand;
  1931.         if not quit then instruct;
  1932.         clearbreak;
  1933.         unsplit;
  1934.       end;
  1935.       nobreak:=true;
  1936.       writeln (^M^M,configset.exitcha,^M^R);
  1937.       SetTimeLeft(StartedTime);
  1938.       write (#27'[J');
  1939.       bottomline;
  1940.       chainstr:='';
  1941.       input:='';
  1942.       write (#13);
  1943.       exit;
  1944.     end;
  1945.     case ord(k) of
  1946.       8:begin
  1947.       if (xsys>1) and fromkbd then
  1948.        begin
  1949.           modeminlock:=true;
  1950.           if xsys>1 then dec(xsys);
  1951.           sendxy(xsys,ysys);
  1952.           write (' ');
  1953.           sendxy(xsys,ysys);
  1954.           if length(linebufs)>0 then linebufs:=copy(linebufs,1,length(linebufs)-1);
  1955.           modeminlock:=false;
  1956.         end;
  1957.       if (xusr>42) and not fromkbd then
  1958.        begin
  1959.           modeminlock:=true;
  1960.           if xusr>42 then dec(xusr);
  1961.           sendxy(xusr,yusr);
  1962.           write (' ');
  1963.           sendxy(xsys,ysys);
  1964.           if length(linebufu)>0 then linebufu:=copy(linebufu,1,length(linebufu)-1);
  1965.           modeminlock:=false;
  1966.         end;
  1967.      end;
  1968.       0:;
  1969.       13:begin
  1970.            bottomline;
  1971.            if fromkbd then begin
  1972.              xsys:=1;
  1973.              inc(ysys);
  1974.          if (ysys>=22) then begin
  1975.            cle(0);
  1976.            ysys:=4;
  1977.            xsys:=1;
  1978.            sendxy(xsys,ysys);
  1979.            ansicolor(urec.statcolor);
  1980.            write(linebufs);
  1981.                ysys:=5;
  1982.          end;
  1983.              sendxy (xsys,ysys);
  1984.          linebufs:='';
  1985.        end else begin
  1986.              xusr:=42;
  1987.              inc(yusr);
  1988.          if (yusr>=22) then begin
  1989.                cle(1);
  1990.                yusr:=5;
  1991.                xusr:=42;
  1992.                ansicolor(urec.inputcolor);
  1993.                sendxy(xusr - 1,yusr);
  1994.                write(linebufu);
  1995.                sendxy(xusr,yusr);
  1996.              end;
  1997.              sendxy(xusr,yusr);
  1998.              linebufu:='';
  1999.            end;
  2000.          end;
  2001.        32:If not fromkbd then Begin linebufu:=''; typedchar (k) end
  2002.           else typedchar(k);
  2003.       33..255:typedchar (k);
  2004.       1..31:if fromkbd and carrier then sendchar(k);
  2005.     end
  2006.   until quit;
  2007.   chainstr:='';
  2008.   input:='';
  2009.   clearbreak
  2010. end;
  2011.  
  2012. Procedure BustChat; (* Pulldown Menus For ViSiON; Use'n Techo-Jock's ToolKit *)
  2013. Var Main_Choice,Choice,Error:integer;
  2014.    ScanTop, ScanBot:byte;
  2015.    M1,MM:Menu_record;
  2016.    Ch:char;
  2017.    X,Y:Byte;
  2018.    Done:Boolean;
  2019.  
  2020. Procedure Which_Chat;
  2021. begin
  2022.     Menu_Set(M1);
  2023.     With M1 do
  2024.     begin
  2025.         Heading1 := 'ViSiON v0.82 Online SysOp Chat Commands';
  2026.         Heading2 := 'Chat Commands';
  2027.         Topic[1] := '   Regular Color - Split Screen';
  2028.         Topic[2] := '   Multi-Colored - Split Screen';
  2029.         Topic[3] := '   Regular Color - Veritcal Chat';
  2030.         Topic[4] := '   Mulit-Colored - Vertical Chat';
  2031.         Topic[5] := '   Regular Color - One Line Chat';
  2032.         Topic[6] := '   SysOp Command Menu';
  2033.         Topic[7] := '   Quit Chat Menu';
  2034.         TotalPicks := 7;
  2035.         PicksPerLine := 1;            {one column of choices}
  2036.         Addprefix := 1;               {add function key prefixes}
  2037.         TopleftXY[1] := 0;            {system will center menu}
  2038.         TopleftXY[2] := 3;            {Y coordinate}
  2039.         Boxtype := 5;                 {fancy box}
  2040.         If ColorScreen then
  2041.         begin
  2042.             Colors[1] := white;           {hi forground}
  2043.             Colors[2] := magenta;            {hi background}
  2044.             Colors[3] := lightgray;             {lo foreground}
  2045.             Colors[4] := blue;       {lo background}
  2046.             Colors[5] := lightgray;            {box color}
  2047.         end
  2048.         else
  2049.         begin
  2050.             Colors[1] := white;           {hi forground}
  2051.             Colors[2] := black;            {hi background}
  2052.             Colors[3] := black;             {lo foreground}
  2053.             Colors[4] := lightgray;       {lo background}
  2054.             Colors[5] := white;            {box color}
  2055.         end;
  2056.         AllowEsc := false;            {inactivate the escape key}
  2057.         Margins := 5;
  2058. end;  {with M1 do}
  2059. end; {Define_Menu1}
  2060.  
  2061.  
  2062. Begin
  2063.     WriteLn(^R'■ '^A'One Moment'^R' ■');
  2064.     SplitScreen(25);
  2065.     Activate_Visible_Screen;
  2066.     SlideRestoreSCreen(2,Down);
  2067.     Clrscr;
  2068.     FillScreen(1,1,80,24,white,blue,chr(176));
  2069.     Findcursor(X,Y,ScanTop,ScanBot);
  2070.     OffCursor;
  2071.     Main_Choice := 1;
  2072.     Done:=False;
  2073.     repeat
  2074.      Which_Chat;
  2075.      DisplayMenu(M1,false,Main_Choice,Error);
  2076.      Case Main_Choice of
  2077.      1 :Begin Oncursor; Chat(False,False); Done:=True; End;
  2078.      2 :Begin Oncursor; Chat(False,True); Done:=True; End;
  2079.      3 :Begin OnCursor; RegChat(False); Done:=True; End;
  2080.      4 :Begin Oncursor; RegChat(True); Done:=TRue; End;
  2081.      5 :Begin OnCursor; OneLineChat; Done:=True End;
  2082.      6 :Begin Done:=True; Chat(True,False); Done:=True; End;
  2083.      7 :Done:=True;
  2084.      end;  {case}
  2085. until Done;
  2086. OnCursor;
  2087. ClrScr;
  2088. UnSplit;
  2089. Main_Choice:=1;
  2090. End;
  2091.  
  2092. begin
  2093. end.
  2094.